home *** CD-ROM | disk | FTP | other *** search
/ QRZ! Ham Radio 8 / QRZ Ham Radio Callsign Database - Volume 8.iso / mac / files / ant_nec / nec81tar.z / nec81tar / datagn2.f < prev    next >
Text File  |  1991-05-13  |  24KB  |  879 lines
  1. C $TITLE: 'DATAGN2'
  2. C $NOFLOATCALLS
  3. C
  4. C
  5.       SUBROUTINE PATCH (NX,NY,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3,X4,Y4,Z4,
  6.      1 X,Y,Z,BI,SALP,T1X,T1Y,T1Z,T2X,T2Y,T2Z,LD)
  7. C     PATCH GENERATES AND MODIFIES PATCH GEOMETRY DATA
  8.       INTEGER*4 N1,N2,N,NP,M1,M2,M,MP,IPSYM
  9.       REAL*8 XA,XST,SALPN,X1,Y1,Z1,X2,Y2,Z2,XNV,YNV,ZNV,S1X,S1Y,S1Z,
  10.      1 S2X,S2Y,S2Z,XN2,YN2,ZN2,XS,YS,ZS,XT,YT,ZT
  11.       COMMON/DATAD/N1,N2,N,NP,M1,M2,M,MP,IPSYM,WLAM
  12.       DIMENSION X(LD),Y(LD),Z(LD),BI(LD),SALP(LD)
  13.       DIMENSION T1X(LD),T1Y(LD),T1Z(LD),T2X(LD),T2Y(LD),T2Z(LD)
  14. C     NEW PATCHES.  FOR NX=0, NY=1,2,3,4 PATCH IS (RESPECTIVELY)
  15. C     ARBITRARY, RECTAGULAR, TRIANGULAR, OR QUADRILATERAL.
  16. C     FOR NX AND NY .GT. 0 A RECTANGULAR SURFACE IS PRODUCED WITH
  17. C     NX BY NY RECTANGULAR PATCHES.
  18.       M=M+1
  19.       MI=LD+1-M
  20.       NTP=NY
  21.       IF (NX.GT.0) NTP=2
  22.       IF (NTP.GT.1) GO TO 2
  23.       X(MI)=X1
  24.       Y(MI)=Y1
  25.       Z(MI)=Z1
  26.       BI(MI)=Z2
  27.       ZNV=DCOS(X2)
  28.       XNV=ZNV*DCOS(Y2)
  29.       YNV=ZNV*DSIN(Y2)
  30.       ZNV=DSIN(X2)
  31.       XA=DSQRT(XNV*XNV+YNV*YNV)
  32.       IF (XA.LT.1.E-6) GO TO 1
  33.       T1X(MI)=-YNV/XA
  34.       T1Y(MI)=XNV/XA
  35.       T1Z(MI)=0.
  36.       GO TO 6
  37. 1     T1X(MI)=1.
  38.       T1Y(MI)=0.
  39.       T1Z(MI)=0.
  40.       GO TO 6
  41. 2     S1X=X2-X1
  42.       S1Y=Y2-Y1
  43.       S1Z=Z2-Z1
  44.       S2X=X3-X2
  45.       S2Y=Y3-Y2
  46.       S2Z=Z3-Z2
  47.       IF (NX.EQ.0) GO TO 3
  48.       S1X=S1X/NX
  49.       S1Y=S1Y/NX
  50.       S1Z=S1Z/NX
  51.       S2X=S2X/NY
  52.       S2Y=S2Y/NY
  53.       S2Z=S2Z/NY
  54. 3     XNV=S1Y*S2Z-S1Z*S2Y
  55.       YNV=S1Z*S2X-S1X*S2Z
  56.       ZNV=S1X*S2Y-S1Y*S2X
  57.       XA=DSQRT(XNV*XNV+YNV*YNV+ZNV*ZNV)
  58.       XNV=XNV/XA
  59.       YNV=YNV/XA
  60.       ZNV=ZNV/XA
  61.       XST=DSQRT(S1X*S1X+S1Y*S1Y+S1Z*S1Z)
  62.       T1X(MI)=S1X/XST
  63.       T1Y(MI)=S1Y/XST
  64.       T1Z(MI)=S1Z/XST
  65.       IF (NTP.GT.2) GO TO 4
  66.       X(MI)=X1+.5*(S1X+S2X)
  67.       Y(MI)=Y1+.5*(S1Y+S2Y)
  68.       Z(MI)=Z1+.5*(S1Z+S2Z)
  69.       BI(MI)=XA
  70.       GO TO 6
  71. 4     IF (NTP.EQ.4) GO TO 5
  72.       X(MI)=(X1+X2+X3)/3.
  73.       Y(MI)=(Y1+Y2+Y3)/3.
  74.       Z(MI)=(Z1+Z2+Z3)/3.
  75.       BI(MI)=.5*XA
  76.       GO TO 6
  77. 5     S1X=X3-X1
  78.       S1Y=Y3-Y1
  79.       S1Z=Z3-Z1
  80.       S2X=X4-X1
  81.       S2Y=Y4-Y1
  82.       S2Z=Z4-Z1
  83.       XN2=S1Y*S2Z-S1Z*S2Y
  84.       YN2=S1Z*S2X-S1X*S2Z
  85.       ZN2=S1X*S2Y-S1Y*S2X
  86.       XST=DSQRT(XN2*XN2+YN2*YN2+ZN2*ZN2)
  87.       SALPN=1./(3.*(XA+XST))
  88.       X(MI)=(XA*(X1+X2+X3)+XST*(X1+X3+X4))*SALPN
  89.       Y(MI)=(XA*(Y1+Y2+Y3)+XST*(Y1+Y3+Y4))*SALPN
  90.       Z(MI)=(XA*(Z1+Z2+Z3)+XST*(Z1+Z3+Z4))*SALPN
  91.       BI(MI)=.5*(XA+XST)
  92.       S1X=(XNV*XN2+YNV*YN2+ZNV*ZN2)/XST
  93.       IF (S1X.GT.0.9998) GO TO 6
  94.       WRITE(*,14)
  95.       STOP
  96. 6     T2X(MI)=YNV*T1Z(MI)-ZNV*T1Y(MI)
  97.       T2Y(MI)=ZNV*T1X(MI)-XNV*T1Z(MI)
  98.       T2Z(MI)=XNV*T1Y(MI)-YNV*T1X(MI)
  99.       SALP(MI)=1.
  100.       IF (NX.EQ.0) GO TO 8
  101.       M=M+NX*NY-1
  102.       XN2=X(MI)-S1X-S2X
  103.       YN2=Y(MI)-S1Y-S2Y
  104.       ZN2=Z(MI)-S1Z-S2Z
  105.       XS=T1X(MI)
  106.       YS=T1Y(MI)
  107.       ZS=T1Z(MI)
  108.       XT=T2X(MI)
  109.       YT=T2Y(MI)
  110.       ZT=T2Z(MI)
  111.       MI=MI+1
  112.       DO 7 IY=1,NY
  113.       XN2=XN2+S2X
  114.       YN2=YN2+S2Y
  115.       ZN2=ZN2+S2Z
  116.       DO 7 IX=1,NX
  117.       XST=IX
  118.       MI=MI-1
  119.       X(MI)=XN2+XST*S1X
  120.       Y(MI)=YN2+XST*S1Y
  121.       Z(MI)=ZN2+XST*S1Z
  122.       BI(MI)=XA
  123.       SALP(MI)=1.
  124.       T1X(MI)=XS
  125.       T1Y(MI)=YS
  126.       T1Z(MI)=ZS
  127.       T2X(MI)=XT
  128.       T2Y(MI)=YT
  129. 7     T2Z(MI)=ZT
  130. 8     IPSYM=0
  131.       NP=N
  132.       MP=M
  133.       RETURN
  134. C
  135. 14    FORMAT (62H ERROR -- CORNERS OF QUADRILATERAL PATCH DO NOT LIE IN
  136.      1A PLANE)
  137.       END
  138. C
  139. C
  140. C     DIVIDE PATCH FOR WIRE CONNECTION
  141. C
  142. C
  143.       SUBROUTINE SUBPH(NX,NY,X,Y,Z,BI,SALP,T1X,T1Y,T1Z,T2X,T2Y,T2Z,LD)
  144.       INTEGER*4 N1,N2,N,NP,M1,M2,M,MP,IPSYM
  145.       COMMON/DATAD/N1,N2,N,NP,M1,M2,M,MP,IPSYM,WLAM
  146.       DIMENSION X(LD),Y(LD),Z(LD),BI(LD),SALP(LD)
  147.       DIMENSION T1X(LD),T1Y(LD),T1Z(LD),T2X(LD),T2Y(LD),T2Z(LD)
  148.       IF (NY.GT.0) GO TO 10
  149.       IF (NX.EQ.M) GO TO 10
  150.       NXP=NX+1
  151.       IXX=LD-M
  152. C**
  153.       DO 9 IY=NXP,M
  154.       IXX=IXX+1
  155.       NYP=IXX-3
  156.       X(NYP)=X(IXX)
  157.       Y(NYP)=Y(IXX)
  158.       Z(NYP)=Z(IXX)
  159.       BI(NYP)=BI(IXX)
  160.       SALP(NYP)=SALP(IXX)
  161.       T1X(NYP)=T1X(IXX)
  162.       T1Y(NYP)=T1Y(IXX)
  163.       T1Z(NYP)=T1Z(IXX)
  164.       T2X(NYP)=T2X(IXX)
  165.       T2Y(NYP)=T2Y(IXX)
  166. 9     T2Z(NYP)=T2Z(IXX)
  167. C**
  168. 10    MI=LD+1-NX
  169.       XS=X(MI)
  170.       YS=Y(MI)
  171.       ZS=Z(MI)
  172.       XA=BI(MI)*.25
  173. C      XST=DSQRT(XA)*.5
  174.       XST=SQRT(XA)*.5
  175.       S1X=T1X(MI)
  176.       S1Y=T1Y(MI)
  177.       S1Z=T1Z(MI)
  178.       S2X=T2X(MI)
  179.       S2Y=T2Y(MI)
  180.       S2Z=T2Z(MI)
  181.       SALN=SALP(MI)
  182.       XT=XST
  183.       YT=XST
  184.       IF (NY.GT.0) GO TO 11
  185.       MIA=MI
  186.       GO TO 12
  187. 11    M=M+1
  188.       MP=MP+1
  189.       MIA=LD+1-M
  190. 12     CONTINUE
  191.       DO 13 IXX=1,4
  192.       X(MIA)=XS+XT*S1X+YT*S2X
  193.       Y(MIA)=YS+XT*S1Y+YT*S2Y
  194.       Z(MIA)=ZS+XT*S1Z+YT*S2Z
  195.       BI(MIA)=XA
  196.       T1X(MIA)=S1X
  197.       T1Y(MIA)=S1Y
  198.       T1Z(MIA)=S1Z
  199.       T2X(MIA)=S2X
  200.       T2Y(MIA)=S2Y
  201.       T2Z(MIA)=S2Z
  202.       SALP(MIA)=SALN
  203.       IF (IXX.EQ.2) YT=-YT
  204.       IF (IXX.EQ.1.OR.IXX.EQ.3) XT=-XT
  205.       MIA=MIA-1
  206. 13    CONTINUE
  207. C**
  208.       M=M+3
  209.       IF (NX.LE.MP) MP=MP+3
  210.       IF (NY.GT.0) Z(MI)=10000.
  211.       RETURN
  212.       END
  213. C
  214. C
  215. C
  216.       SUBROUTINE ARC(ITG,NS,RADA,ANG1,ANG2,RAD,X,Y,Z,BI,ITAG,X2,Y2,
  217.      1 Z2,LD)
  218. C
  219. C     ARC GENERATES SEGMENT GEOMETRY DATA FOR AN ARC OF NS SEGMENTS
  220. C
  221.       INTEGER*4 ITAG,N1,N2,N,NP,M1,M2,M,MP,IPSYM
  222.       REAL*8 ANG,RADA,ANG1,ANG2,RAD,TA
  223.       COMMON/DATAD/N1,N2,N,NP,M1,M2,M,MP,IPSYM,WLAM
  224.       DIMENSION X(LD),Y(LD),Z(LD),BI(LD)
  225.       DIMENSION X2(LD),Y2(LD),Z2(LD),ITAG(LD)
  226.       DATA TA/.01745329252D0/
  227.       IST=N+1
  228.       N=N+NS
  229.       NP=N
  230.       MP=M
  231.       IPSYM=0
  232.       IF (NS.LT.1) RETURN
  233.       IF (ABS(ANG2-ANG1).LT.360.00001) GO TO 1
  234.       WRITE(*,3)
  235.       STOP
  236. 1     ANG=ANG1*TA
  237.       DANG=(ANG2-ANG1)*TA/NS
  238.       XS1=RADA*DCOS(ANG)
  239.       ZS1=RADA*DSIN(ANG)
  240.       DO 2 I=IST,N
  241.       ANG=ANG+DANG
  242.       XS2=RADA*DCOS(ANG)
  243.       ZS2=RADA*DSIN(ANG)
  244.       X(I)=XS1
  245.       Y(I)=0.
  246.       Z(I)=ZS1
  247.       X2(I)=XS2
  248.       Y2(I)=0.
  249.       Z2(I)=ZS2
  250.       XS1=XS2
  251.       ZS1=ZS2
  252.       BI(I)=RAD
  253. 2     ITAG(I)=ITG
  254.       RETURN
  255. C
  256. 3     FORMAT (40H ERROR -- ARC ANGLE EXCEEDS 360. DEGREES)
  257.       END
  258. C
  259. C
  260. C
  261.       SUBROUTINE CONECT(X,Y,Z,BI,SALP,T1X,T1Y,T1Z,T2X,T2Y,T2Z,
  262.      1 ICON1,ICON2,ICONX,IGND,IW,LD)
  263. C
  264. C     CONNECT SETS UP SEGMENT CONNECTION DATA IN ARRAYS ICON1 AND ICON2
  265. C     BY SEARCHING FOR SEGMENT ENDS THAT ARE IN CONTACT.
  266. C
  267.       INTEGER*4 ICON1,ICON2,ICONX,N1,N2,N,NP,M1,M2,M,MP,IPSYM
  268.       REAL*8 AX,BX,CX
  269.       COMMON/DATAD/N1,N2,N,NP,M1,M2,M,MP,IPSYM,WLAM
  270.       COMMON/SEGJ/AX(30),BX(30),CX(30),JCO(30),JSNO,ISCON(50),NSCON,
  271.      1 IPCON(10),NPCON
  272.       DIMENSION ICON1(LD),ICON2(LD),ICONX(LD)
  273.       DIMENSION X(LD),Y(LD),Z(LD),BI(LD),SALP(LD)
  274.       DIMENSION T1X(LD),T1Y(LD),T1Z(LD),T2X(LD),T2Y(LD),T2Z(LD)
  275.       DATA JMAX/30/,SMIN/1.E-3/,NSMAX/50/,NPMAX/10/
  276. C**
  277.       NSCON=0
  278.       NPCON=0
  279.       IF (IGND.EQ.0) GO TO 3
  280.       WRITE(IW,54)
  281.       IF (IGND.GT.0) WRITE(IW,55)
  282.       IF (IPSYM.NE.2) GO TO 1
  283.       NP=2*NP
  284.       MP=2*MP
  285. 1     IF (IABS(IPSYM).LE.2) GO TO 2
  286.       NP=N
  287.       MP=M
  288. 2     IF (NP.GT.N) STOP
  289.       IF (NP.EQ.N.AND.MP.EQ.M) IPSYM=0
  290. 3     IF (N.EQ.0) GO TO 26
  291.       DO 15 I=1,N
  292.       ICONX(I)=0
  293.       XI1=X(I)
  294.       YI1=Y(I)
  295.       ZI1=Z(I)
  296.       XI2=T1X(I)
  297.       YI2=T1Y(I)
  298.       ZI2=T1Z(I)
  299. C      SLEN=DSQRT((XI2-XI1)**2+(YI2-YI1)**2+(ZI2-ZI1)**2)*SMIN
  300.       SLEN=SQRT((XI2-XI1)**2+(YI2-YI1)**2+(ZI2-ZI1)**2)*SMIN
  301. C
  302. C     DETERMINE CONNECTION DATA FOR END 1 OF SEGMENT.
  303. C
  304.       IF (IGND.LT.1) GO TO 5
  305.       IF (ZI1.GT.-SLEN) GO TO 4
  306.       WRITE(*,56)  I
  307.       STOP
  308. 4     IF (ZI1.GT.SLEN) GO TO 5
  309.       ICON1(I)=I
  310.       Z(I)=0.
  311.       GO TO 9
  312. 5     IC=I
  313.       DO 7 J=2,N
  314.       IC=IC+1
  315.       IF (IC.GT.N) IC=1
  316.       SEP=ABS(XI1-X(IC))+ABS(YI1-Y(IC))+ABS(ZI1-Z(IC))
  317.       IF (SEP.GT.SLEN) GO TO 6
  318.       ICON1(I)=-IC
  319.       GO TO 8
  320. 6     SEP=ABS(XI1-T1X(IC))+ABS(YI1-T1Y(IC))+ABS(ZI1-T1Z(IC))
  321.       IF (SEP.GT.SLEN) GO TO 7
  322.       ICON1(I)=IC
  323.       GO TO 8
  324. 7     CONTINUE
  325.       IF (I.LT.N2.AND.ICON1(I).GT.10000) GO TO 8
  326.       ICON1(I)=0
  327. C
  328. C     DETERMINE CONNECTION DATA FOR END 2 OF SEGMENT.
  329. C
  330. 8     IF (IGND.LT.1) GO TO 12
  331. 9     IF (ZI2.GT.-SLEN) GO TO 10
  332.       WRITE(*,56)  I
  333.       STOP
  334. 10    IF (ZI2.GT.SLEN) GO TO 12
  335.       IF (ICON1(I).NE.I) GO TO 11
  336.       WRITE(*,57)  I
  337.       STOP
  338. 11    ICON2(I)=I
  339.       T1Z(I)=0.
  340.       GO TO 15
  341. 12    IC=I
  342.       DO 14 J=2,N
  343.       IC=IC+1
  344.       IF (IC.GT.N) IC=1
  345.       SEP=ABS(XI2-X(IC))+ABS(YI2-Y(IC))+ABS(ZI2-Z(IC))
  346.       IF (SEP.GT.SLEN) GO TO 13
  347.       ICON2(I)=IC
  348.       GO TO 15
  349. 13    SEP=ABS(XI2-T1X(IC))+ABS(YI2-T1Y(IC))+ABS(ZI2-T1Z(IC))
  350.       IF (SEP.GT.SLEN) GO TO 14
  351.       ICON2(I)=-IC
  352.       GO TO 15
  353. 14    CONTINUE
  354.       IF (I.LT.N2.AND.ICON2(I).GT.10000) GO TO 15
  355.       ICON2(I)=0
  356. 15    CONTINUE
  357.       IF (M.EQ.0) GO TO 26
  358. C     FIND WIRE-SURFACE CONNECTIONS FOR NEW PATCHES
  359.       IX=LD+1-M1
  360.       I=M2
  361. 16    IF (I.GT.M) GO TO 20
  362.       IX=IX-1
  363.       XS=X(IX)
  364.       YS=Y(IX)
  365.       ZS=Z(IX)
  366.       DO 18 ISEG=1,N
  367.       XI1=X(ISEG)
  368.       YI1=Y(ISEG)
  369.       ZI1=Z(ISEG)
  370.       XI2=T1X(ISEG)
  371.       YI2=T1Y(ISEG)
  372.       ZI2=T1Z(ISEG)
  373.       SLEN=(ABS(XI2-XI1)+ABS(YI2-YI1)+ABS(ZI2-ZI1))*SMIN
  374. C     FOR FIRST END OF SEGMENT
  375.       SEP=ABS(XI1-XS)+ABS(YI1-YS)+ABS(ZI1-ZS)
  376.       IF (SEP.GT.SLEN) GO TO 17
  377. C     CONNECTION - DIVIDE PATCH INTO 4 PATCHES AT PRESENT ARRAY LOC.
  378.       ICON1(ISEG)=10000+I
  379.       IC=0
  380.       CALL SUBPH(I,IC,X,Y,Z,BI,SALP,T1X,T1Y,T1Z,T2X,T2Y,T2Z,LD)
  381.       GO TO 19
  382. 17    SEP=ABS(XI2-XS)+ABS(YI2-YS)+ABS(ZI2-ZS)
  383.       IF (SEP.GT.SLEN) GO TO 18
  384.       ICON2(ISEG)=10000+I
  385.       IC=0
  386.       CALL SUBPH(I,IC,X,Y,Z,BI,SALP,T1X,T1Y,T1Z,T2X,T2Y,T2Z,LD)
  387.       GO TO 19
  388. 18    CONTINUE
  389. 19    I=I+1
  390.       GO TO 16
  391. C     REPEAT SEARCH FOR NEW SEGMENTS CONNECTED TO NGF PATCHES.
  392. 20    IF (M1.EQ.0.OR.N2.GT.N) GO TO 26
  393.       IX=LD+1
  394.       I=1
  395. 21    IF (I.GT.M1) GO TO 25
  396.       IX=IX-1
  397.       XS=X(IX)
  398.       YS=Y(IX)
  399.       ZS=Z(IX)
  400.       DO 23 ISEG=N2,N
  401.       XI1=X(ISEG)
  402.       YI1=Y(ISEG)
  403.       ZI1=Z(ISEG)
  404.       XI2=T1X(ISEG)
  405.       YI2=T1Y(ISEG)
  406.       ZI2=T1Z(ISEG)
  407.       SLEN=(ABS(XI2-XI1)+ABS(YI2-YI1)+ABS(ZI2-ZI1))*SMIN
  408.       SEP=ABS(XI1-XS)+ABS(YI1-YS)+ABS(ZI1-ZS)
  409.       IF (SEP.GT.SLEN) GO TO 22
  410.       ICON1(ISEG)=10001+M
  411.       IC=1
  412.       NPCON=NPCON+1
  413.       IPCON(NPCON)=I
  414.       CALL SUBPH(I,IC,X,Y,Z,BI,SALP,T1X,T1Y,T1Z,T2X,T2Y,T2Z,LD)
  415.       GO TO 24
  416. 22    SEP=ABS(XI2-XS)+ABS(YI2-YS)+ABS(ZI2-ZS)
  417.       IF (SEP.GT.SLEN) GO TO 23
  418.       ICON2(ISEG)=10001+M
  419.       IC=1
  420.       NPCON=NPCON+1
  421.       IPCON(NPCON)=I
  422.       CALL SUBPH(I,IC,X,Y,Z,BI,SALP,T1X,T1Y,T1Z,T2X,T2Y,T2Z,LD)
  423.       GO TO 24
  424. 23    CONTINUE
  425. 24    I=I+1
  426.       GO TO 21
  427. 25    IF (NPCON.LE.NPMAX) GO TO 26
  428.       WRITE(*,62)  NPMAX
  429.       STOP
  430. 26    WRITE(IW,58)  N,NP,IPSYM
  431.       IF (M.GT.0) WRITE(IW,61)  M,MP
  432.       ISEG=(N+M)/(NP+MP)
  433.       IF (ISEG.EQ.1) GO TO 30
  434.       IF (IPSYM) 28,27,29
  435. 27    STOP
  436. 28    WRITE(IW,59) ISEG
  437.       GO TO 30
  438. 29    IC=ISEG/2
  439.       IF (ISEG.EQ.8) IC=3
  440.       WRITE(IW,60)  IC
  441. 30    IF (N.EQ.0) GO TO 48
  442.       WRITE(IW,50)
  443.       ISEG=0
  444. C     ADJUST CONNECTED SEG. ENDS TO EXACTLY COINCIDE.  PRINT JUNCTIONS
  445. C     OF 3 OR MORE SEG.  ALSO FIND OLD SEG. CONNECTING TO NEW SEG.
  446.       DO 44 J=1,N
  447.       IEND=-1
  448.       JEND=-1
  449.       IX=ICON1(J)
  450.       IC=1
  451.       JCO(1)=-J
  452.       XA=X(J)
  453.       YA=Y(J)
  454.       ZA=Z(J)
  455. 31    IF (IX.EQ.0) GO TO 43
  456.       IF (IX.EQ.J) GO TO 43
  457.       IF (IX.GT.10000) GO TO 43
  458.       NSFLG=0
  459. 32    IF (IX) 33,49,34
  460. 33    IX=-IX
  461.       GO TO 35
  462. 34    JEND=-JEND
  463. 35    IF (IX.EQ.J) GO TO 37
  464.       IF (IX.LT.J) GO TO 43
  465.       IC=IC+1
  466.       IF (IC.GT.JMAX) GO TO 49
  467.       JCO(IC)=IX*JEND
  468.       IF (IX.GT.N1) NSFLG=1
  469.       IF (JEND.EQ.1) GO TO 36
  470.       XA=XA+X(IX)
  471.       YA=YA+Y(IX)
  472.       ZA=ZA+Z(IX)
  473.       IX=ICON1(IX)
  474.       GO TO 32
  475. 36    XA=XA+T1X(IX)
  476.       YA=YA+T1Y(IX)
  477.       ZA=ZA+T1Z(IX)
  478.       IX=ICON2(IX)
  479.       GO TO 32
  480. 37    SEP=IC
  481.       XA=XA/SEP
  482.       YA=YA/SEP
  483.       ZA=ZA/SEP
  484.       DO 39 I=1,IC
  485.       IX=JCO(I)
  486.       IF (IX.GT.0) GO TO 38
  487.       IX=-IX
  488.       X(IX)=XA
  489.       Y(IX)=YA
  490.       Z(IX)=ZA
  491.       GO TO 39
  492. 38    T1X(IX)=XA
  493.       T1Y(IX)=YA
  494.       T1Z(IX)=ZA
  495. 39    CONTINUE
  496.       IF (N1.EQ.0) GO TO 42
  497.       IF (NSFLG.EQ.0) GO TO 42
  498.       DO 41 I=1,IC
  499.       IX=IABS(JCO(I))
  500.       IF (IX.GT.N1) GO TO 41
  501.       IF (ICONX(IX).NE.0) GO TO 41
  502.       NSCON=NSCON+1
  503.       IF (NSCON.LE.NSMAX) GO TO 40
  504.       WRITE(*,62)  NSMAX
  505.       STOP
  506. 40    ISCON(NSCON)=IX
  507.       ICONX(IX)=NSCON
  508. 41    CONTINUE
  509. 42    IF (IC.LT.3) GO TO 43
  510.       ISEG=ISEG+1
  511.       WRITE(IW,51) ISEG,(JCO(I),I=1,IC)
  512. 43    IF (IEND.EQ.1) GO TO 44
  513.       IEND=1
  514.       JEND=1
  515.       IX=ICON2(J)
  516.       IC=1
  517.       JCO(1)=J
  518.       XA=T1X(J)
  519.       YA=T1Y(J)
  520.       ZA=T1Z(J)
  521.       GO TO 31
  522. 44    CONTINUE
  523.       IF (ISEG.EQ.0) WRITE(IW,52)
  524.       IF (N1.EQ.0.OR.M1.EQ.M) GO TO 48
  525. C     FIND OLD SEGMENTS THAT CONNECT TO NEW PATCHES
  526.       DO 47 J=1,N1
  527.       IX=ICON1(J)
  528.       IF (IX.LT.10000) GO TO 45
  529.       IX=IX-10000
  530.       IF (IX.GT.M1) GO TO 46
  531. 45    IX=ICON2(J)
  532.       IF (IX.LT.10000) GO TO 47
  533.       IX=IX-10000
  534.       IF (IX.LT.M2) GO TO 47
  535. 46    IF (ICONX(J).NE.0) GO TO 47
  536.       NSCON=NSCON+1
  537.       ISCON(NSCON)=J
  538.       ICONX(J)=NSCON
  539. 47    CONTINUE
  540. 48    CONTINUE
  541. C**
  542. C     WRITE(*,*) ' CONECT RETURN'
  543. C**
  544.       RETURN
  545. 49    WRITE(*,53)  IX
  546.       STOP
  547. C
  548. 50    FORMAT (//,9X,27H- MULTIPLE WIRE JUNCTIONS -,/,1X,8HJUNCTION,4X,36
  549.      1HSEGMENTS  (- FOR END 1, + FOR END 2))
  550. 51    FORMAT (1X,I5,5X,20I5,/,(11X,20I5))
  551. 52    FORMAT (2X,4HNONE)
  552. 53    FORMAT (47H CONNECT - SEGMENT CONNECTION ERROR FOR SEGMENT,I5)
  553. 54    FORMAT (/,3X,23HGROUND PLANE SPECIFIED.)
  554. 55    FORMAT (/,3X,46HWHERE WIRE ENDS TOUCH GROUND, CURRENT WILL BE ,38H
  555.      1INTERPOLATED TO IMAGE IN GROUND PLANE.,/)
  556. 56    FORMAT (30H GEOMETRY DATA ERROR-- SEGMENT,I5,21H EXTENDS BELOW GRO
  557.      1UND)
  558. 57    FORMAT (29H GEOMETRY DATA ERROR--SEGMENT,I5,16H LIES IN GROUND ,6H
  559.      1PLANE.)
  560. 58    FORMAT (/,3X,20HTOTAL SEGMENTS USED=,I5,5X,12HNO. SEG. IN ,17HA SY
  561.      1MMETRIC CELL=,I5,5X,14HSYMMETRY FLAG=,I3)
  562. 59    FORMAT (14H STRUCTURE HAS,I4,25H FOLD ROTATIONAL SYMMETRY,/)
  563. 60    FORMAT (14H STRUCTURE HAS,I2,19H PLANES OF SYMMETRY,/)
  564. 61    FORMAT (3X,19HTOTAL PATCHES USED=,I5,6X,32HNO. PATCHES IN A SYMMET
  565.      1RIC CELL=,I5)
  566. 62    FORMAT(54H ERROR - NO. NEW SEGMENTS CONNECTED TO N.G.F. SEGMENTS,
  567.      128H OR PATCHES EXCEEDS LIMIT OF,I5)
  568.       END
  569. C***
  570. C***    WILL REPLACE SUBROUTINE HELIX WITH ONE FROM NEC3   RWA 02 APR 89
  571. C***
  572. C***  SUBROUTINE HELIX(IW,ITG,NS,RAD1,RAD2,HT,TURNS,RAD,X,Y,Z,
  573. C*** 1 BI,ITAG,X2,Y2,Z2,LD)
  574. C
  575. C     SUBROUTINE HELIX GENERATES SEGMENT GEOMETRY DATA FOR A HELIX/SPIRAL
  576. C
  577. C       RAD1 IS THE STRUCTURE RADIUS AT THE START
  578. C       RAD2 IS THE STRUCTURE RADIUS AT THE END
  579. C       HT IS THE STRUCTURE HEIGHT IN THE Z DIRECTION
  580. C       TURNS IS THE TOTAL NUMBER OF WINDINGS
  581. C
  582. C       ASSUMING THAT RAD1.LE.RAD2 AND HT.NE.0, SAVE
  583. C         IF RAD1.EQ.RAD2 THE STRUCTURE WILL BE A HELIX
  584. C         IF RAD1.LT.RAD2 THE STRUCTURE WILL BE A SPIRAL
  585. C         IF TURNS.GT.0   THE STRUCTURE WILL BE RIGHT-HANDED
  586. C         IF TURNS.LT.0   THE STRUCTURE WILL BE LEFT-HANDED
  587. C
  588. C***  INTEGER*4 ITAG,N1,N2,N,NP,M1,M2,M,MP,IPSYM
  589. C***  REAL*8 PI,HT,RAD1,RAD2,RAD,TWOPI
  590. C***  COMMON/DATAD/N1,N2,N,NP,M1,M2,M,MP,IPSYM,WLAM
  591. C***  DIMENSION X2(LD),Y2(LD),Z2(LD),ITAG(LD)
  592. C***  DIMENSION X(LD),Y(LD),Z(LD),BI(LD)
  593. C***  DATA PI/3.141592654D0/
  594. C***  IST = N+1
  595. C***  N = N+NS
  596. C***  NP = N
  597. C***  MP = M
  598. C***  IPSYM = 0
  599. C***  IF(NS.LT.1) RETURN
  600. C***  TWOPI = 2.0*PI
  601. C***  DO 100 I=1,NS
  602. C***    PHI1 = FLOAT(I-1)/FLOAT(NS)
  603. C***    PHI2 = FLOAT(I)/FLOAT(NS)
  604. C***    R1 = (1.0-PHI1)*RAD1 + PHI1*RAD2
  605. C***    R2 = (1.0-PHI2)*RAD1 + PHI2*RAD2
  606. C***    ANGLE1 = TWOPI*TURNS*PHI1
  607. C***    ANGLE2 = TWOPI*TURNS*PHI2
  608. C***    X(IST) = R1*COS(ANGLE1)
  609. C***    Y(IST) = R1*SIN(ANGLE1)
  610. C***    Z(IST) = PHI1*HT
  611. C***    X2(IST) = R2*COS(ANGLE2)
  612. C***    Y2(IST) = R2*SIN(ANGLE2)
  613. C***    Z2(IST) = PHI2*HT
  614. C***    BI(IST) = RAD
  615. C***    ITAG(IST) = ITG
  616. C***    IST = IST+1
  617. C***100   CONTINUE
  618. C***  IF(RAD1.EQ.RAD2) THEN
  619. C***    PITCH = ABS(HT/TURNS)
  620. C***    WRITE(IW,110) PITCH
  621. CCC110  FORMAT(3X,'THE PITCH OF THE HELIX IS ',F10.4)
  622. C***  ELSE
  623. C***    XS = ABS(HT)
  624. C***    YS = ABS(RAD2-RAD1)
  625. C***    ANGLE = ATAN2(YS,XS)*(180.0/PI)
  626. C***    WRITE(IW,120) ANGLE
  627. CCC120  FORMAT(3X,'THE HALF APEX ANGLE OF THE SPIRAL IS ',F7.3)
  628. C***  ENDIF
  629. C***  RETURN
  630. C***  END
  631. C
  632.       SUBROUTINE HELIX(IW,S,HL,A1,B1,A2,B2,RAD,NS,ITG,X,Y,Z,
  633.      1 BI,ITAG,X2,Y2,Z2,LD)
  634. C     SUBROUTINE HELIX GENERATES SEGMENT GEOMETRY DATA FOR A HELIX OF NS
  635. C     SEGMENTS
  636.       INTEGER*4 ITAG,N1,N2,N,NP,M1,M2,M,MP,IPSYM
  637.       REAL*8 PI,S,HL,A1,B1,A2,B2
  638.       COMMON/DATAD/N1,N2,N,NP,M1,M2,M,MP,IPSYM,WLAM
  639.       DIMENSION X2(LD),Y2(LD),Z2(LD),ITAG(LD)
  640.       DIMENSION X(LD),Y(LD),Z(LD),BI(LD)
  641.       DATA PI/3.141592654D0/
  642.       IST=N+1
  643.       N=N+NS
  644.       NP=N
  645.       MP=M
  646.       IPSYM=0
  647.       IF(NS.LT.1) RETURN
  648.       TURNS=ABS(HL/S)
  649.       ZINC=ABS(HL/NS)
  650.       Z(IST)=0.
  651.       DO 25 I=IST,N
  652.       BI(I)=RAD
  653.       ITAG(I)=ITG
  654.       IF(I.NE.IST) Z(I)=Z(I-1)+ZINC
  655.       Z2(I)=Z(I)+ZINC
  656.       IF(A2.NE.A1) GO TO 10
  657.       IF(B1.EQ.0) B1=A1
  658.       X(I)=A1*DCOS(2.*PI*Z(I)/S)
  659.       Y(I)=B1*DSIN(2.*PI*Z(I)/S)
  660.       X2(I)=A1*DCOS(2.*PI*Z2(I)/S)
  661.       Y2(I)=B1*DSIN(2.*PI*Z2(I)/S)
  662.       GO TO 20
  663. 10    IF(B2.EQ.0) B2=A2
  664.       X(I)=(A1+(A2-A1)*Z(I)/ABS(HL))*DCOS(2.*PI*Z(I)/S)
  665.       Y(I)=(B1+(B2-B1)*Z(I)/ABS(HL))*DSIN(2.*PI*Z(I)/S)
  666.       X2(I)=(A1+(A2-A1)*Z2(I)/ABS(HL))*DCOS(2.*PI*Z2(I)/S)
  667.       Y2(I)=(B1+(B2-B1)*Z2(I)/ABS(HL))*DSIN(2.*PI*Z2(I)/S)
  668. 20    IF(HL.GT.0) GO TO 25
  669.       COPY=X(I)
  670.       X(I)=Y(I)
  671.       Y(I)=COPY
  672.       COPY=X2(I)
  673.       X2(I)=Y2(I)
  674.       Y2(I)=COPY
  675. 25    CONTINUE
  676.       IF(A2.EQ.A1) GO TO 21
  677.       SANGLE=DATAN(A2/(ABS(HL)+(ABS(HL)*A1)/(A2-A1)))
  678.       WRITE(IW,104)  SANGLE
  679. 104   FORMAT(5X,'THE CONE ANGLE OF THE SPIRAL IS',F10.4)
  680.        RETURN
  681. 21    IF(A1.NE.B1) GO TO 30
  682.       HDIA=2.*A1
  683.       TURN=HDIA*PI
  684.       PITCH=DATAN(S/(PI*HDIA))
  685. C      TURN=TURN/DCOS(PITCH)
  686.       TURN=TURN/COS(PITCH)
  687.       PITCH=180.*PITCH/PI
  688.       GO TO 40
  689. 30    IF(A1.LT.B1) GO TO 34
  690.       HMAJ=2.*A1
  691.       HMIN=2.*B1
  692.       GO TO 35
  693. 34    HMAJ=2.*B1
  694.       HMIN=2.*A1
  695. C     35    HDIA=DSQRT((HMAJ**2+HMIN**2)/2*HMAJ)
  696. 35    HDIA=SQRT((HMAJ**2+HMIN**2)/2*HMAJ)
  697.       TURN=2.*PI*HDIA
  698.       PITCH=(180./PI)*DATAN(S/(PI*HDIA))
  699. 40    WRITE(IW,105) PITCH,TURN
  700. 105   FORMAT(5X,'THE PITCH ANGLE IS',F10.4/5X,'THE LENGTH OF WIRE/TURN I
  701.      1S',F10.4)
  702.       RETURN
  703.       END
  704.       SUBROUTINE GFIL(CM,ZARRAY,X,Y,Z,SI,BI,ALP,BET,SALP,
  705.      1 ICON1,ICON2,ITAG,IP,IW,IGFL,IPRT,LD,LD2,IRESRV)
  706. C
  707. C     GFIL READS THE N.G.F. FILE
  708. C
  709. CLARGE: CM
  710.       COMPLEX CM
  711.       COMPLEX*16 ZARRAY,SSX
  712.       COMPLEX*16 ZRATI,ZRATI2,T1,FRATI
  713. C**
  714.       REAL*4 DXA,DYA,XSA,YSA
  715.       COMPLEX*8 AR1,AR2,AR3,EPSCF
  716. C**
  717.       INTEGER*4 ICON1,ICON2,ITAG,IOUT,I,J,K,N,N1,N2,IOP,
  718.      1 NP,M1,M2,M,MP,IPSYM,NEQ,NPEQ,NOP,IDM1
  719.       INTEGER*4 IMAT,NPBLK,NLAST,NLSYM,NBBX,NPBX,NLBX,NBBL,NPBL,NLBL
  720.       COMMON/DATAD/N1,N2,N,NP,M1,M2,M,MP,IPSYM,WLAM
  721.       COMMON/GND/ZRATI,ZRATI2,FRATI,CL,CH,SCRWL,SCRWR,NRADL,KSYMP,
  722.      1IFAR,IPERF,T1,T2
  723.       COMMON/GGRID/AR1(11,10,4),AR2(17,5,4),AR3(9,8,4),EPSCF,DXA(3),
  724.      1 DYA(3),XSA(3),YSA(3),NXA(3),NYA(3)
  725.       COMMON/MATPAR/ICASE,NBLOKS,NPBLK,NLAST,NBLSYM,NPSYM,NLSYM,IMAT,
  726.      1 ICASX,NBBX,NPBX,NLBX,NBBL,NPBL,NLBL
  727.       COMMON/SMAT/ SSX(16,16)
  728.       COMMON/ZLOAD/ NLOAD,NLODF
  729.       COMMON/SAVE/ KCOM,COM(19,5),EPSR,SIG,SCRWLT,SCRWRT,FMHZ
  730.       DIMENSION CM(IRESRV),ZARRAY(LD),IP(LD2),ICON1(LD),ICON2(LD),
  731.      1 ITAG(LD)
  732.       DIMENSION X(LD),Y(LD),Z(LD),SI(LD),BI(LD),ALP(LD),BET(LD),
  733.      1 SALP(LD)
  734. C**
  735. C**   DATA IGFL/20/
  736. C**
  737. C $NODEBUG
  738. C**
  739. C     D     WRITE(*,*) '   GFIL: START, IGFL=',IGFL
  740. C**
  741. C** GREEN'S FUNCTION FILE NAME WILL BE REQUESTED HERE IF IGFL
  742. C**  HAS NOT YET BEEN CONNECTED TO 'TAPE.[IGFL]' BY GFOUT
  743. C**
  744.       WRITE(*,'(A,I2,A)') ' OPEN UNIT ',IGFL,' FOR N.G.F. INPUT  FILE'
  745.       READ (IGFL) N1,NP,M1,MP,WLAM,FMHZ,IPSYM,KSYMP,IPERF,NRADL,EPSR,
  746.      1 SIG,SCRWLT,SCRWRT,NLODF,KCOM
  747. C**
  748. $DEBUG
  749. C**
  750.       N=N1
  751.       M=M1
  752.       N2=N1+1
  753.       M2=M1+1
  754.       IDM1=1
  755.       IF (N1.EQ.0) GO TO 2
  756. C     READ SEG. DATA AND CONVERT BACK TO END COORD. IN UNITS OF METERS
  757.       READ (IGFL) (X(I),I=1,N1),(Y(I),I=1,N1),(Z(I),I=1,N1)
  758.       READ (IGFL) (SI(I),I=1,N1),(BI(I),I=1,N1),(ALP(I),I=1,N1)
  759.       READ (IGFL) (BET(I),I=1,N1),(SALP(I),I=1,N1)
  760.       READ (IGFL) (ICON1(I),I=1,N1),(ICON2(I),I=1,N1)
  761.       READ (IGFL) (ITAG(I),I=1,N1)
  762.       IF (NLODF.NE.0) READ (IGFL) (ZARRAY(I),I=1,N1)
  763.       DO 1 I=1,N1
  764.       XI=X(I)*WLAM
  765.       YI=Y(I)*WLAM
  766.       ZI=Z(I)*WLAM
  767.       DX=SI(I)*.5*WLAM
  768.       X(I)=XI-ALP(I)*DX
  769.       Y(I)=YI-BET(I)*DX
  770.       Z(I)=ZI-SALP(I)*DX
  771.       SI(I)=XI+ALP(I)*DX
  772.       ALP(I)=YI+BET(I)*DX
  773.       BET(I)=ZI+SALP(I)*DX
  774.       BI(I)=BI(I)*WLAM
  775. 1     CONTINUE
  776. 2     IF (M1.EQ.0) GO TO 4
  777.       J=LD-M1+1
  778. C     READ PATCH DATA AND CONVERT TO METERS
  779.       READ (IGFL) (X(I),I=J,LD),(Y(I),I=J,LD),(Z(I),I=J,LD)
  780.       READ (IGFL) (SI(I),I=J,LD),(BI(I),I=J,LD),(ALP(I),I=J,LD)
  781.       READ (IGFL) (BET(I),I=J,LD),(SALP(I),I=J,LD)
  782.       READ (IGFL) (ICON1(I),I=J,LD),(ICON2(I),I=J,LD)
  783.       READ (IGFL) (ITAG(I),I=J,LD)
  784.       DX=WLAM*WLAM
  785.       DO 3 I=J,LD
  786.       X(I)=X(I)*WLAM
  787.       Y(I)=Y(I)*WLAM
  788.       Z(I)=Z(I)*WLAM
  789. 3     BI(I)=BI(I)*DX
  790. 4     READ (IGFL) ICASE,NBLOKS,NPBLK,NLAST,NBLSYM,NPSYM,NLSYM,IMAT
  791.       IF (IPERF.EQ.2) READ (IGFL) AR1,AR2,AR3,EPSCF,DXA,DYA,XSA,YSA,
  792.      1 NXA,NYA
  793.       NEQ=N1+2*M1
  794.       NPEQ=NP+2*MP
  795.       NOP=NEQ/NPEQ
  796.       IF (NOP.GT.1) READ (IGFL) ((SSX(I,J),I=1,NOP),J=1,NOP)
  797.       READ (IGFL) (IP(I),I=1,NEQ),COM
  798. C     READ MATRIX A AND WRITE TAPE13 FOR OUT OF CORE
  799.       IF (ICASE.GT.2) GO TO 5
  800.       IOUT=NEQ*NPEQ
  801.       READ (IGFL) (CM(I),I=1,IOUT)
  802.       GO TO 10
  803. 5     REWIND 13
  804.       IF (ICASE.NE.4) GO TO 7
  805.       IOUT=NPEQ*NPEQ
  806.       DO 6 K=1,NOP
  807.       READ (IGFL) (CM(J),J=1,IOUT)
  808. 6     WRITE (13) (CM(J),J=1,IOUT)
  809.       GO TO 9
  810. 7     IOUT=NPSYM*NPEQ*2
  811.       NBL2=2*NBLSYM
  812.       DO 8 IOP=1,NOP
  813.       DO 8 I=1,NBL2
  814.       CALL BLCKIN (CM,IDM1,IOUT,1,206,IGFL)
  815. 8     CALL BLCKOT (CM,IDM1,IOUT,1,205,13)
  816. 9     REWIND 13
  817. 10    REWIND IGFL
  818. C     WRITE(IW,N) G.F. HEADING
  819.       WRITE(IW,16)
  820.       WRITE(IW,14)
  821.       WRITE(IW,14)
  822.       WRITE(IW,17)
  823.       WRITE(IW,18)  N1,M1
  824.       IF (NOP.GT.1) WRITE(IW,19)  NOP
  825.       WRITE(IW,20)  IMAT,ICASE
  826.       IF (ICASE.LT.3) GO TO 11
  827.       NBL2=NEQ*NPEQ
  828.       WRITE(IW,21)  NBL2
  829. 11    WRITE(IW,22)  FMHZ
  830.       IF (KSYMP.EQ.2.AND.IPERF.EQ.1) WRITE(IW,23)
  831.       IF (KSYMP.EQ.2.AND.IPERF.EQ.0) WRITE(IW,27)
  832.       IF (KSYMP.EQ.2.AND.IPERF.EQ.2) WRITE(IW,28)
  833.       IF (KSYMP.EQ.2.AND.IPERF.NE.1) WRITE(IW,24)  EPSR,SIG
  834.       WRITE(IW,17)
  835.       DO 12 J=1,KCOM
  836. 12    WRITE(IW,15)  (COM(I,J),I=1,19)
  837.       WRITE(IW,17)
  838.       WRITE(IW,14)
  839.       WRITE(IW,14)
  840.       WRITE(IW,16)
  841.       IF (IPRT.EQ.0) GOTO 100
  842.       WRITE(IW,25)
  843.       DO 13 I=1,N1
  844. 13    WRITE(IW,26)  I,X(I),Y(I),Z(I),SI(I),ALP(I),BET(I)
  845. 100     CONTINUE
  846. C**
  847.       CLOSE(IGFL)
  848. C**
  849. C     D     WRITE(*,*) '   GFIL:  CLOSE N.G.F. INPUT  FILE AND RETURN'
  850. C**
  851.       RETURN
  852. C
  853. 14    FORMAT (5X,50H**************************************************,3
  854.      14H**********************************)
  855. 15    FORMAT (5X,3H** ,19A4,5H   **)
  856. 16    FORMAT (////)
  857. 17    FORMAT (5X,2H**,80X,2H**)
  858. 18    FORMAT (5X,29H** NUMERICAL GREEN'S FUNCTION,53X,2H**,/,5X,17H** NO
  859.      1. SEGMENTS =,I4,10X,13HNO. PATCHES =,I4,34X,2H**)
  860. 19    FORMAT (5X,27H** NO. SYMMETRIC SECTIONS =,I4,51X,2H**)
  861. 20    FORMAT (5X,34H** N.G.F. MATRIX -  CORE STORAGE =,I7,23H COMPLEX NU
  862.      1MBERS,  CASE,I2,16X,2H**)
  863. 21    FORMAT (5X,2H**,19X,13HMATRIX SIZE =,I7,16H COMPLEX NUMBERS,25X,2H
  864.      1**)
  865. 22    FORMAT (5X,14H** FREQUENCY =,1P,E12.5,5H MHZ.,51X,2H**)
  866. 23    FORMAT (5X,17H** PERFECT GROUND,65X,2H**)
  867. 24    FORMAT (5X,44H** GROUND PARAMETERS - DIELECTRIC CONSTANT =,1P,
  868.      1E12.5,26X,2H**,/,5X,2H**,21X,14HCONDUCTIVITY =,E12.5,8H MHOS/M.,
  869.      225X,2H**)
  870. 25    FORMAT (39X,31HNUMERICAL GREEN'S FUNCTION DATA,/,41X,27HCOORDINATE
  871.      1S OF SEGMENT ENDS,/,51X,8H(METERS),/,5X,4HSEG.,11X,19H- - - END ON
  872.      2E - - -,26X,19H- - - END TWO - - -,/,6X,3HNO.,6X,1HX,14X,1HY,14X,1
  873.      3HZ,14X,1HX,14X,1HY,14X,1HZ)
  874. 26    FORMAT (1X,I7,1P,6E15.6)
  875. 27    FORMAT (5X,55H** FINITE GROUND.  REFLECTION COEFFICIENT APPROXIMAT
  876.      1ION,27X,2H**)
  877. 28    FORMAT (5X,38H** FINITE GROUND.  SOMMERFELD SOLUTION,44X,2H**)
  878.       END
  879.